home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp.lbr / XLDMEM.CQ / xldmem.c
Encoding:
C/C++ Source or Header  |  1985-06-03  |  13.2 KB  |  508 lines
  1.              /* xldmem - xlisp dynamic memory management routines */
  2.  
  3. #ifdef CI_86
  4. #include "a:stdio.h"
  5. #include "xlisp.h"
  6. #endif
  7.  
  8. #ifdef AZTEC
  9. #include "a:stdio.h"
  10. #include "xlisp.h"
  11. #endif
  12.  
  13. #ifdef unix
  14. #include <stdio.h>
  15. #include <xlisp.h>
  16. #endif
  17.  
  18.  
  19.  
  20.                             /* useful definitions */
  21.  
  22. #define ALLOCSIZE (sizeof(struct segment) + anodes * sizeof(struct node))
  23.  
  24.  
  25.                     /* memory segment structure definition */
  26.  
  27. struct segment {
  28.     int sg_size;
  29.     struct segment *sg_next;
  30.     struct node sg_nodes[];
  31. };
  32.  
  33.                             /* external variables */
  34.  
  35. extern struct node *oblist;
  36. extern struct node *xlstack;
  37. extern struct node *xlenv;
  38.  
  39.  
  40.                             /* external procedures */
  41.  
  42. extern char *malloc();
  43. extern char *calloc();
  44.  
  45.  
  46.                               /* local variables */
  47.  
  48. int anodes,nnodes,nsegs,nfree,gccalls;
  49. static struct segment *segs;
  50. static struct node *fnodes;
  51.  
  52.  
  53.                        /**********************************
  54.                        *  newnode - allocate a new node  *
  55.                        **********************************/
  56.  
  57. struct node *newnode(type)
  58.   int type;
  59. {
  60.     struct node *nnode;
  61.  
  62.     /* get a free node */
  63.     if ((nnode = fnodes) == NULL) {
  64.         gc();
  65.         if ((nnode = fnodes) == NULL)
  66.             xlfail("insufficient node space");
  67.     }
  68.  
  69.     /* unlink the node from the free list */
  70.     fnodes = nnode->n_right;
  71.     nfree -= 1;
  72.  
  73.     /* initialize the new node */
  74.     nnode->n_type = type;
  75.     nnode->n_left = NULL;
  76.     nnode->n_right = NULL;
  77.  
  78.     /* return the new node */
  79.     return (nnode);
  80. }
  81.  
  82.  
  83.  /*****************************************************************************
  84.  *  stralloc - allocate memory for a string adding a byte for the terminator  *
  85.  *****************************************************************************/
  86.  
  87. char *stralloc(size)
  88.   int size;
  89. {
  90.     char *sptr;
  91.  
  92.     /* allocate memory for the string copy */
  93.     if ((sptr = malloc(size+1)) == NULL) {
  94.         gc();
  95.         if ((sptr = malloc(size+1)) == NULL)
  96.             xlfail("insufficient string space");
  97.     }
  98.  
  99.     /* return the new string memory */
  100.     return (sptr);
  101. }
  102.  
  103.  
  104.                /**************************************************
  105.                *  strsave - generate a dynamic copy of a string  *
  106.                **************************************************/
  107.  
  108. char *strsave(str)
  109.   char *str;
  110. {
  111.     char *sptr;
  112.  
  113.     /*     */
  114.     sptr = stralloc(strlen(str));
  115.     strcpy(sptr,str);
  116.  
  117.     /* return the new string */
  118.     return (sptr);
  119. }
  120.  
  121.  
  122.                        /*********************************
  123.                        *  strfree - free string memory  *
  124.                        *********************************/
  125.  
  126. strfree(str)
  127.   char *str;
  128. {
  129.     free(str);
  130. }
  131.  
  132.  
  133.                            /*************************
  134.                            *  gc - garbage collect  *
  135.                            *************************/
  136.  
  137. static gc()
  138. {
  139.     unmark();                          /* Unmark all nodes */
  140.  
  141. #ifdef DEBUG
  142.     xldbgmsg("\n\tOBLIST mark");
  143.     mark(oblist);
  144.     xldbgmsg("\n\tSTACK mark");
  145.     mark(xlstack);
  146.     xldbgmsg("\n\tENVIRONMENT");
  147.     mark(xlenv);
  148. #else
  149.     mark(oblist);                      /* Mark all accessible nodes */
  150.     mark(xlstack);
  151.     mark(xlenv);
  152. #endif
  153.  
  154.     sweep();                           /* Sweep up the grabage */
  155.  
  156.     if (fnodes == NULL)                /* Allocate more if necessary */
  157.         addseg();
  158.  
  159.     gccalls += 1;
  160. }
  161.  
  162.  
  163.                          /******************************
  164.                          *  unmark - unmark each node  *
  165.                          ******************************/
  166.  
  167. static unmark()
  168. {
  169.     struct node *n = xlstack;
  170.  
  171.     while (n != NULL)                       /* Unmark the stack */
  172.     {
  173.         n->n_flags &= ~(MARK | LEFT);
  174.         n = n->n_listnext;
  175.     }
  176. }
  177.  
  178.                      /*************************************
  179.                      *  mark - mark all accessible nodes  *
  180.                      *************************************/
  181.  
  182. static mark(ptr)
  183.   struct node *ptr;
  184. {
  185.     struct node *this,*prev,*tmp;
  186.  
  187.     if (ptr == NULL)                   /* Return on null */
  188.         return;
  189.  
  190.     prev = NULL;                       /* Initialize */
  191.     this = ptr;
  192.  
  193.     while (TRUE)                       /* Mark this list */
  194.     {
  195.         while (TRUE)                   /* Descend as far as we can */
  196.         {
  197.             if (this->n_flags & MARK)  /* Node already marked ? */
  198.                 break;
  199.             else                       /* NO : mark it and its descendents */
  200.             {
  201.  
  202. #ifdef DEBUG
  203.                 xldump(this);
  204. #endif
  205.                 this->n_flags |= MARK; /* This node ...*/
  206.  
  207.                 if (left(this))        /* .. the left sublist */
  208.                 {
  209.                     this->n_flags |= LEFT;
  210.                     tmp = prev;
  211.                     prev = this;
  212.                     this = prev->n_left;
  213.                     prev->n_left = tmp;
  214.                 }
  215.                 else
  216.                 if (right(this))       /* .. the right sublist */
  217.                 {
  218.                     this->n_flags &= ~LEFT;
  219.                     tmp = prev;
  220.                     prev = this;
  221.                     this = prev->n_right;
  222.                     prev->n_right = tmp;
  223.                 }
  224.                 else
  225.                     break;
  226.             }
  227.         }
  228.  
  229.         while (TRUE)                   /* Backup to last restart point */
  230.         {
  231.             if (prev == NULL)          /* Finished yet ? */
  232.                 return;
  233.  
  234.             if (prev->n_flags & LEFT)  /* Coming from left side ? */
  235.             {
  236.                 if (right(prev))
  237.                 {
  238.                     prev->n_flags &= ~LEFT;
  239.                     tmp = prev->n_left;
  240.                     prev->n_left = this;
  241.                     this = prev->n_right;
  242.                     prev->n_right = tmp;
  243.                     break;
  244.                 }
  245.                 else
  246.                 {
  247.                     tmp = prev;
  248.                     prev = tmp->n_left;
  249.                     tmp->n_left = this;
  250.                     this = tmp;
  251.                 }
  252.             }
  253.             else                       /* came from the right side */
  254.             {
  255.                 tmp = prev;
  256.                 prev = tmp->n_right;
  257.                 tmp->n_right = this;
  258.                 this = tmp;
  259.             }
  260.         }
  261.     }
  262. }
  263.  
  264.  
  265.       /*******************************************************************
  266.       *  sweep - sweep all unmarked nodes and add them to the free list  *
  267.       *******************************************************************/
  268.  
  269. static sweep()
  270. {
  271.     struct segment *seg;
  272.     struct node *n;
  273.     int i;
  274.  
  275.     fnodes = NULL;                               /* Empty the free list */
  276.     nfree = 0;
  277.  
  278.     /* add all unmarked nodes */
  279.     for (seg = segs; seg != NULL; seg = seg->sg_next)
  280.         for (i = 0; i < seg->sg_size; i++)
  281.             if (!((n = &seg->sg_nodes[i])->n_flags & MARK))
  282.             {
  283.                 switch (n->n_type)
  284.                 {
  285.                 case STR:
  286.                         if (n->n_strtype == DYNAMIC && n->n_str != NULL)
  287.                             strfree(n->n_str);
  288.                         break;
  289.  
  290.                 case SYM:
  291.                         if (n->n_symname != NULL)
  292.                             strfree(n->n_symname);
  293.                         break;
  294.  
  295. #ifdef KEYMAPCLASS
  296.                 case KMAP:
  297.                         xlkmfree(n);
  298.                         break;
  299. #endif
  300.                 }
  301.  
  302.                 n->n_type = FREE;
  303.                 n->n_left = NULL;
  304.                 n->n_right = fnodes;
  305.                 fnodes = n;
  306.                 nfree += 1;
  307.             }
  308.             else
  309.                 n->n_flags &= ~MARK;
  310. }
  311.  
  312.  
  313.               /***************************************************
  314.               *  addseg - add a segment to the available memory  *
  315.               ***************************************************/
  316.  
  317. static int addseg()
  318. {
  319.     struct segment *newseg;
  320.     int i;
  321.  
  322.                                        /* allocate a new segment */
  323.     if ((newseg = (struct segment *) calloc(1,ALLOCSIZE)) != NULL)
  324.     {
  325.         newseg->sg_size = anodes;      /* Initialize the new segment */
  326.         newseg->sg_next = segs;
  327.         segs = newseg;
  328.                                        /* add each new node to the free list */
  329.         for (i = 0; i < newseg->sg_size; i++)
  330.         {
  331.             newseg->sg_nodes[i].n_right = fnodes;
  332.             fnodes = &newseg->sg_nodes[i];
  333.         }
  334.  
  335.         nnodes += anodes;              /* Update the statistics */
  336.         nfree += anodes;
  337.         nsegs += 1;
  338.  
  339.         return (TRUE);                 /* return success */
  340.     }
  341.     else
  342.         return (FALSE);
  343. }
  344.  
  345.  
  346.                       /************************************
  347.                       *  left - check for a left sublist  *
  348.                       ************************************/
  349.  
  350. static int left(n)
  351.   struct node *n;
  352. {
  353.     switch (n->n_type)
  354.     {
  355.     case SYM:
  356.     case SUBR:
  357.     case INT:
  358.     case STR:
  359.     case FPTR:
  360.     case REAL:
  361.             return (FALSE);
  362.  
  363. #ifdef KEYMAPCLASS
  364.     case KMAP:
  365.             xlkmmark(n);
  366.             return (FALSE);
  367. #endif
  368.  
  369.     case LIST:
  370.     case OBJ:
  371.             return (n->n_left != NULL);
  372.  
  373.     default:
  374.             printf("bad node type (%d) found during left scan\n",n->n_type);
  375.             exit();
  376.     }
  377. }
  378.  
  379.  
  380.                      /**************************************
  381.                      *  right - check for a right sublist  *
  382.                      **************************************/
  383.  
  384. static int right(n)
  385.   struct node *n;
  386. {
  387.     switch (n->n_type)
  388.     {
  389.     case SUBR:
  390.     case INT:
  391.     case REAL:
  392.     case STR:
  393.     case FPTR:
  394.     case KMAP:
  395.             return (FALSE);
  396.  
  397.     case SYM:
  398.     case LIST:
  399.     case OBJ:
  400.             return (n->n_right != NULL);
  401.  
  402.     default:
  403.             printf("bad node type (%d) found during right scan\n",n->n_type);
  404.             exit();
  405.     }
  406. }
  407.  
  408.  
  409.                       /************************************
  410.                       *  stats - print memory statistics  *
  411.                       ************************************/
  412.  
  413. static stats()
  414. {
  415.     printf("\nNodes:       %d\n",nnodes);
  416.     printf("Free nodes:  %d\n",nfree);
  417.     printf("Segments:    %d\n",nsegs);
  418.     printf("Allocate:    %d\n",anodes);
  419.     printf("Collections: %d\n\n",gccalls);
  420. }
  421.  
  422.  
  423.              /*****************************************************
  424.              *  fgc - xlisp function to force garbage collection  *
  425.              *****************************************************/
  426.  
  427. static struct node *fgc(args)
  428.   struct node *args;
  429. {
  430.     xllastarg(args);                   /* No arguments */
  431.     gc();                              /* Collect that garbage */
  432.     return (NULL);
  433. }
  434.  
  435.  
  436.             /*******************************************************
  437.             *  fexpand - xlisp function to force memory expansion  *
  438.             *******************************************************/
  439.  
  440. static struct node *fexpand(args)
  441.   struct node *args;
  442. {
  443.     struct node *val;
  444.     int n,i;
  445.  
  446.                                        /* get new number to allocate */
  447.     n = (args == NULL) ? 1 : xlevmatch(INT, &args)->n_int;
  448.     xllastarg(args);                   /* No more arguments */
  449.  
  450.     for (i = 0; i < n; i++)            /* Allocate more segments */
  451.         if (!addseg())
  452.             break;
  453.  
  454.     val = newnode(INT);                /* Return number of segments added */
  455.     val->n_int = i;
  456.     return (val);
  457. }
  458.  
  459.       /*******************************************************************
  460.       *  falloc - xlisp function to set the number of nodes to allocate  *
  461.       *******************************************************************/
  462.  
  463. static struct node *falloc(args)
  464.   struct node *args;
  465. {
  466.     struct node *val;
  467.     int n,oldn;
  468.  
  469.     n = xlevmatch(INT,&args)->n_int;   /* new number to allocate */
  470.     xllastarg(args);                   /* No more arguments */
  471.  
  472.     oldn = anodes;                     /* Set new number */
  473.     anodes = n;
  474.  
  475.     val = newnode(INT);                /* Return old value */
  476.     val->n_int = oldn;
  477.     return (val);
  478. }
  479.  
  480.  
  481.              /*****************************************************
  482.              *  fmem - xlisp function to print memory statistics  *
  483.              *****************************************************/
  484.  
  485. static struct node *fmem(args)
  486.   struct node *args;
  487. {
  488.     xllastarg(args);                   /* No arguments */
  489.     stats();                           /* Print statistics */
  490.     return (NULL);
  491. }
  492.  
  493.  
  494.              /******************************************************
  495.              *  xldmeminit - initialize the dynamic memory module  *
  496.              ******************************************************/
  497.  
  498. xldmeminit()
  499. {
  500.     anodes = NNODES;                   /* Default number of nodes */
  501.     nnodes = nsegs = nfree = gccalls = 0;
  502.  
  503.     xlsubr("gc",fgc);                  /* Define some xlisp functions */
  504.     xlsubr("expand",fexpand);
  505.     xlsubr("alloc",falloc);
  506.     xlsubr("mem",fmem);
  507. }
  508.